#!/usr/bin/env perl

BEGIN {
	push @INC,".." if -f "../pv3.pm";
	push @INC,$ENV{CODEMGR_LIBS} if exists($ENV{CODEMGR_LIBS});
}

use pv3;
use Getopt::Long;
use strict;
use POSIX qw(strftime);
use Data::Dumper;
use Config;

$::ARG_pv=undef;
$::ARG_sanity=0;

sub usage {
	print "
Usage: pv3_status [-p DIR] [-s] file ...

The pv3_status command allows you to check to see whether
a particular file that is being managed by PV2 is currently
checked out - and by whom. It can also be used to indicate
if the file has unrecognised content compared to the checked 
in versions of the file.

The command supports the following command line arguments:

-p  The filename to use as the PV3 version control database
    for files in this directory.
-s  Perform additional sanity checks - for indicating if the 
    file contents are not recognised, or non-current version
    checked out etc.

Written by Simon Edwards, (C) 2006-2010 www.advantsys.co.uk
";
	exit 1;
}

if(!GetOptions(
	"pv=s"		=> \$::ARG_pv,
	"sanity"	=> \$::ARG_sanity,
	)) {
	usage;
}

my %args=();
$args{SANITY}=1 if $::ARG_sanity;

@::STATUS_LIST=();

if($Config{osname} =~ /mswin/i) {
	my @F=();
	for my $cpat (@ARGV) {
		push @F,glob($cpat);
	}
	@ARGV=@F;
}

for my $cfile (@ARGV) {
	next if -d $cfile;
	next if $cfile =~ /,pv3$/;
	push @::STATUS_LIST,$cfile;
}

$args{FILE}=[@::STATUS_LIST];

{
	my $res=pv3::status(%args);
	my $res2;
	if($::ARG_sanity) {
		$res2=pv3::info2(%args);
	}

	# Returns [-1,msg[,file]]		- file does not exist, or not under code control#
	#         [-2,msg,file]			- warning - see msg (sanity check only)
	#         [0,file]			- file checked in and sane
	#	  [1,nv,sha1,user,date,file] 	- checked out [details specified]
	#	  [2,file]			- check in but local contents unrecognised.
	#         [3,nv,sha1,file]		- not checked out, but 'non-current' version locally

	my $warns=0;
	my $errors=0;

	for my $cres (@$res2) {
		my @R=@$cres;
		if($R[0]==-2) {
			$warns++;
			if(@R==3) {
				print "WARNING: $R[2] - $R[1]\n";
			} else {
				print "WARNING: $R[1]\n";
			}
		}
	}
	for my $cres (@$res) {
		my @R=@$cres;
		next if $R[0]==0;
		if($R[0]==-1) {
			$errors++;
			if(@R==3) {
				print "ERROR: $R[2] - $R[1]\n";
			} else {
				print "ERROR: $R[1]\n";
			}
		}
		if($R[0]==1) {
			print "$R[5] : $R[2],$R[1] - $R[3]\n";
		}
	}

	for my $cres (@$res) {
		my @R=@$cres;
		next if $R[0]==0;
		if($R[0]==3 && ! $::ARG_sanity) {
			$warns++;
			if(@R==4) {
				print "$R[3] : $R[2],$R[1] - not latest.\n";
			}
		}
	}

	for my $cres (@$res) {
		my @R=@$cres;
		next if $R[0]==0;
		if($R[0]==2) {
			$errors++;
			if(@R==2) {
				print "ERROR: $R[1] - unrecognised content.\n";
			}
		}
	}
	exit(2) if $errors;
	exit(1) if $warns;
}

exit(0);

